home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d2 / uneedit.arc / SYSID32.ARC / SYSID.PAS < prev    next >
Pascal/Delphi Source File  |  1988-12-17  |  54KB  |  1,446 lines
  1. (*
  2. **  SYSID.PAS
  3. **  Version 3.2
  4. **
  5. **  Usage:  [d:][path]SYSID
  6. **
  7. **  A system description for DOS-based PC/XT/AT- and PS/2-class machines.
  8. **  SYSID generates 12 screens of information about the host system and runs
  9. **  under DOS versions 3.0 and later.
  10. **
  11. **  My primary source of ideas in SYSID was Ray Duncan's book Advanced MS-DOS.
  12. **  Terje Mathisen supplied the DISKREAD function.  The CPUID object module is
  13. **  largely and shamelessly stolen from Bob Smith's article "Chips in
  14. **  Transition" (PC Tech Journal 4:4 p.56).
  15. **
  16. **  Some of the techniques SYSID uses are not documented or officially
  17. **  supported by either IBM or Microsoft.  Where possible I have followed the
  18. **  undocumented routine with a comment describing my source for the
  19. **  technique.
  20. **
  21. **  SYSID was developed on an IBM PC with Turbo Pascal version 4.0 and DOS
  22. **  version 3.30.  The source code has been split into two files: SYSID.PAS
  23. **  (this file) and an include file, SYSID.INC, which contains all function
  24. **  and procedure declarations.  (The original single source file simply
  25. **  outgrew the capacity of the Turbo Pascal editor.)  The CPUID object module
  26. **  was developed with the WordPerfect Library Program Editor version 4.1 and
  27. **  the Microsoft Macro Assembler version 3.0.
  28. **
  29. **  Known bugs:
  30. **    1) The PS/2 Model 80 on which I tested SYSID inexplicably choked on the
  31. **       CPUID external assembly language procedure.
  32. **    2) Page 1:  On some machines with an 80286 CPU the CPUID module
  33. **       mistakenly identifies the CPU as a NEC V30.
  34. **    3) Page 4:  The Compaq Deskpro 386 on which I tested SYSID sometimes,
  35. **       but not always, choked on the "Scan lines/character" item.
  36. **    4) Page 5:  The description of foreground color will not mention the
  37. **       blinking attribute, even if it was enabled before you invoked SYSID.
  38. **    5) Page 6:  SYSID may report that you have no mouse when in fact you do.
  39. **       SYSID relies on INT 51H for its mouse information, but some mouse
  40. **       device drivers (Logitech's MOUSE.SYS, for example) don't use INT 51H.
  41. **       (On page 9 SYSID will always find the mouse's device driver if one is
  42. **       loaded.)  Does the PC Magazine article on which this section is based
  43. **       have any basis in fact?
  44. **    6) Page 8:  SYSID used to report incorrectly the statuses of some of the
  45. **       the executable files which use the "multiplex interrupt" (INT 2FH).
  46. **       I have commented these status checks out of the source code,
  47. **       determined to do battle with them another day.  Can anyone supply the
  48. **       correct INT 2FH functions for these files?  Or are some of them red
  49. **       herrings that simply check INT 2FH to see if *other* files have been
  50. **       loaded (e.g. APPEND/ASSIGN)?
  51. **    7) Page 12:  The speaker doesn't always beep the first time you hit
  52. **       <PgDn>.  Similarly, you won't always get beeped when you hit <PgUp>
  53. **       when you're on page 1.  This seems to be an idiosyncrasy of Turbo
  54. **       Pascal, not SYSID.
  55. **
  56. **  Both the source and object code of SYSID are hereby released into the
  57. **  public domain.  Neither version carries any warranty, expressed or
  58. **  implied, of merchantability or fitness for a particular purpose.
  59. **
  60. **  Comments, suggestions, and questions may be addressed to:
  61. **      BIXMail: sjgrant
  62. **      CompuServe: 71101,706
  63. **
  64. **  Steve Grant
  65. **  Long Beach, CA
  66. **  July 8, 1988
  67. *)
  68.  
  69. (*$B-*)
  70. (*$D-*)
  71. (*$F-*)
  72. (*$I-*)
  73. (*$L+*)
  74. (*$M 16384, 0, 655360*)
  75. (*$N-*)
  76. (*$R-*)
  77. (*$S-*)
  78. (*$T+*)
  79. (*$V-*)
  80.  
  81. program SYSID;
  82.  
  83. uses
  84.   crt,
  85.   dos,
  86.   graph;
  87.  
  88. const
  89.   BIOSext = $AA55;
  90.   BIOSseg = $0040;
  91.   cassetteint = $15;
  92.   EGAseg = $C000;
  93.   EMMint = $67;
  94.   filesmax = 256;
  95.   HDCseg = $C800;
  96.   mouseint = $51;
  97.   nuldev = 'NUL     ';
  98.   PCROMseg = $F000;
  99.   pgmax = 12;
  100.   pchar1 : set of char = [#9, #10, #13, ' '..'~'];
  101.   pchar2 : set of char = [' '..'~'];
  102.   qEMMdrvr = 'EMMXXXX0';
  103.   qhexpref = '$';
  104.   qindent = '  ';
  105.   qspace2 = '  ';
  106.   qspace3 = '   ';
  107.   qspace4 = '    ';
  108.   qspace7 = '       ';
  109.   qversion = 'Version 3.2';
  110.   secsiz1 = 511;
  111.   strmax = 255;
  112.   tickrate = 55;
  113.  
  114. type
  115.   str4 = string[4];
  116.   str9 = string[9];
  117.   str19 = string[19];
  118.  
  119. var
  120.   attrsave : byte;
  121.   bootrec : array[0..secsiz1] of byte;
  122.   bootstat : word;
  123.   ccode : word;
  124.   country : array[0..33] of byte;
  125.   cpuword : word;
  126.   currdrv : byte;
  127.   devofs : word;
  128.   devseg : word;
  129.   DOScofs : word;
  130.   DOScseg : word;
  131.   dosmem : longint;
  132.   EGABIOS1 : word;
  133.   EGABIOS2 : word;
  134.   EMMarray : array[$000..$3FF] of word;
  135.   equip : word;
  136.   f : array[1..filesmax] of file;
  137.   graphdriver : integer;
  138.   graphmode : integer;
  139.   HDCBIOS1 : word;
  140.   HDCBIOS2 : word;
  141.   header : array[0..17] of byte;
  142.   i : word;
  143.   intofs : array[$00..$FF] of word;
  144.   intseg : array[$00..$FF] of word;
  145.   j : word;
  146.   lqindent : byte;
  147.   osmajor : byte;
  148.   osminor : byte;
  149.   PCBIOS1 : word;
  150.   PCBIOS2 : word;
  151.   pg : 1..pgmax;
  152.   regs : registers;
  153.   search : searchrec;
  154.   strunk : str9;
  155.   tlength : byte;
  156.   topline : byte;
  157.   twidth : byte;
  158.   vidpg : byte;
  159.   x1 : byte;
  160.   x2 : byte;
  161.   xbool1 : boolean;
  162.   xbool2 : boolean;
  163.   xbool3 : boolean;
  164.   xbyte1 : byte;
  165.   xbyte2 : byte;
  166.   xchar1 : char;
  167.   xchar2 : char;
  168.   xint1 : integer;
  169.   xint2 : integer;
  170.   xlongint : longint;
  171.   xstring : string;
  172.   xword1 : word;
  173.   xword2 : word;
  174.   xword3 : word;
  175.   xword4 : word;
  176.   xword5 : word;
  177.  
  178. (*$I SYSID.INC *)
  179.  
  180. begin
  181.   with regs do begin
  182.     AH := $30;
  183.     MSDOS(regs);
  184.     osmajor := AL;
  185.     osminor := AH;
  186.     if osmajor >= 3 then begin
  187.       attrsave := textattr;
  188.       cpuword := cpuid;
  189.       detectgraph(graphdriver, graphmode);
  190.       (*   BIX ms.dos/secrets #1322   *)
  191.       if (graphdriver = EGA) or (graphdriver = VGA) then
  192.         tlength := mem[BIOSseg : $0084] + 1
  193.       else
  194.         tlength := 25;
  195.       AH := $0F;
  196.       intr($10, regs);
  197.       twidth := AH;
  198.       vidpg := BH;
  199.       write('Working...');
  200.       strunk := '(unknown)'#0;
  201.       if BIOSscan(PCROMseg, $E000, $FFFF, xword1) then begin
  202.         PCBIOS1 := PCROMseg;
  203.         PCBIOS2 := xword1
  204.       end else
  205.         BIOSunk(PCBIOS1, PCBIOS2);
  206.       intr($11, regs);
  207.       equip := AX;
  208.       (*   Byte 12:12 p.178   *)
  209.       intr($12, regs);
  210.       dosmem := $400 * longint(AX);
  211.       AX := $5200;
  212.       MSDOS(regs);
  213.       devseg := ES;
  214.       devofs := BX;
  215.       for i := $00 to $FF do begin
  216.         AH := $35;
  217.         AL := i;
  218.         MSDOS(regs);
  219.         intseg[i] := ES;
  220.         intofs[i] := BX;
  221.       end;
  222.       (*   BIX ms.dos/secrets #1032   *)
  223.       if graphdriver = EGA then
  224.         if (memw[EGAseg : $0000] = BIOSext)
  225.           and BIOSscan(EGAseg, $0002, $3FFF, xword1) then begin
  226.           EGABIOS1 := EGAseg;
  227.           EGABIOS2 := xword1
  228.         end else
  229.           BIOSunk(EGABIOS1, EGABIOS2);
  230.       AX := $3400;
  231.       MSDOS(regs);
  232.       DOScseg := ES;
  233.       DOScofs := BX;
  234.       (*   BIX ms.dos/secrets #2   *)
  235.       AX := $3800;
  236.       DS := seg(country);
  237.       DX := ofs(country);
  238.       MSDOS(regs);
  239.       ccode := BX;
  240.       AH := $19;
  241.       MSDOS(regs);
  242.       currdrv := AL;
  243.       i := 0;
  244.       xword1 := HDCseg;
  245.       xbool2 := false;
  246.       repeat
  247.         if (memw[xword1 : $0000] = BIOSext)
  248.           and BIOSscan(xword1, $0002, $1FFF, xword2) then begin
  249.           xbool2 := true;
  250.           HDCBIOS1 := xword1;
  251.           HDCBIOS2 := xword2
  252.         end else if i < 3 then begin
  253.           inc(i);
  254.           inc(xword1, $0200)
  255.         end else begin
  256.           xbool2 := true;
  257.           BIOSunk(HDCBIOS1, HDCBIOS2)
  258.         end
  259.       until xbool2;
  260.       bootstat := diskread(currdrv, 0, 1, bootrec);
  261.       textbackground(black);
  262.       window(1, 1, twidth, tlength);
  263.       clrscr;
  264.       textcolor(green);
  265.       write('SYSID');
  266.       textcolor(lightgray);
  267.       write(' - System description for IBM PC''s and compatibles');
  268.       rjustify(qversion);
  269.       writeln;
  270.       border;
  271.       gotoxy(1, tlength - 1);
  272.       border;
  273.       writeln;
  274.       write('Page ');
  275.       x1 := wherex;
  276.       write(pgmax, ' of ', pgmax);
  277.       textcolor(green);
  278.       rjustify('PgDn PgUp Home End Esc');
  279.       x2 := wherex;
  280.       pg := 1;
  281.       lqindent := length(qindent);
  282.       xbool1 := false;
  283.       repeat
  284.         gotoxy(x1, tlength);
  285.         textcolor(lightgray);
  286.         write(pg : 2);
  287.         window(1, 3, twidth, tlength - 2);
  288.         clrscr;
  289.         case pg of
  290.           1 : begin
  291.             caption2('Machine type');
  292.             xbool2 := true;
  293.             if intinit(cassetteint) then begin
  294.               AH := $C0;
  295.               intr(cassetteint, regs);
  296.               if nocarry then begin
  297.                 xbool2 := false;
  298.                 xword1 := memw[ES : BX + 2];
  299.                 if xword1 = $01FC then
  300.                   writeln('PC-AT 3x9')
  301.                 else if xword1 = $01FB then
  302.                   writeln('PC-XT/2')
  303.                 else if xword1 = $02FC then
  304.                   writeln('PC-XT/286')
  305.                 else if xword1 = $00F9 then
  306.                   writeln('PC-Convertible')
  307.                 else if xword1 = $00FA then
  308.                   writeln('PS/2 Model 30')
  309.                 else if xword1 = $04FC then
  310.                   writeln('PS/2 Model 50')
  311.                 else if xword1 = $05FC then
  312.                   writeln('PS/2 Model 60')
  313.                 else if xword1 = $00F8 then
  314.                   writeln('PS/2 Model 80')
  315.                 else if xword1 = $00FC then
  316.                   writeln('7531/2 Industrial AT')
  317.                 else if xword1 = $06FC then
  318.                   writeln('7552 Gearbox')
  319.                 else
  320.                   unknown('machine - model/type word', xword1, 4);
  321.                 caption2(qindent + 'BIOS revision level');
  322.                 writeln(mem[ES : BX + 4]);
  323.                 caption2(qindent + 'Hardware configuration');
  324.                 writeln(bin8(mem[ES : BX + 5]))
  325.               end
  326.             end;
  327.             if xbool2 then begin
  328.               xbyte1 := mem[$FFFF : $000E];
  329.               case xbyte1 of
  330.                 $FF : writeln('PC');
  331.                 $FE : writeln('PC-XT');
  332.                 $FD : writeln('PCjr');
  333.                 $FC : writeln('PC-AT')
  334.                 else
  335.                   unknown('machine - model byte', xbyte1, 2)
  336.               end
  337.             end;
  338.             (*   Byte 12:12 p. 174   *)
  339.             caption2('BIOS source');
  340.             showBIOS(PCBIOS1, PCBIOS2);
  341.             caption2('BIOS date');
  342.             xstring := '';
  343.             i := 0;
  344.             xbool2 := false;
  345.             repeat
  346.               if i < strmax then begin
  347.                 xchar1 := chr(mem[$FFFF : $0005 + i]);
  348.                 if xchar1 in pchar2 then begin
  349.                   xstring := xstring + xchar1;
  350.                   inc(i)
  351.                 end else
  352.                   xbool2 := true
  353.               end else
  354.                 xbool2 := true;
  355.             until xbool2;
  356.             if i > 7 then
  357.               writeln(xstring)
  358.             else
  359.               dontknow;
  360.             caption2('CPU');
  361.             xbyte1 := hi(cpuword);
  362.             case xbyte1 of
  363.               $00 : writeln('NEC V20');
  364.               $01 : writeln('NEC V30');
  365.               $07 : writeln('Intel 80286 or 80386');
  366.               $08 : writeln('Intel 8088');
  367.               $09 : writeln('Intel 8086');
  368.               $0A : writeln('Intel 80188');
  369.               $0B : writeln('Intel 80186');
  370.               $0F : writeln('Intel 80286')
  371.               else
  372.                 unknown('CPU ID byte', xbyte1, 2);
  373.             end;
  374.             caption1(qindent + 'Interrupts ');
  375.             if (xbyte1 and $08) = $00 then
  376.               write('do not ');
  377.             write('corrupt');
  378.             caption1(' multi-prefix string instructions');
  379.             writeln;
  380.             caption1(qindent + 'PUSH SP ');
  381.             if (xbyte1 and $04) = $04 then
  382.               write('writes, then decrements')
  383.             else
  384.               write('decrements, then writes');
  385.             caption1(' SP');
  386.             writeln;
  387.             caption1(qindent + 'Shift instructions use ');
  388.             if (xbyte1 and $02) = $02 then
  389.               write('only lower 5')
  390.             else
  391.               write('all 8');
  392.             caption1(' bits of second register operand');
  393.             writeln;
  394.             caption1(qindent + 'Prefetch instruction queue is ');
  395.             if (xbyte1 and $01) = $01 then
  396.               write('6')
  397.             else
  398.               write('4');
  399.             caption1(' bytes');
  400.             writeln;
  401.             caption2('Coprocessor present');
  402.             xbyte1 := lo(cpuword);
  403.             case xbyte1 of
  404.               $00 : writeln('no');
  405.               $01 : writeln('8087');
  406.               $02 : writeln('80287')
  407.               else
  408.                 unknown('coprocessor type', xbyte1, 2)
  409.             end;
  410.             caption2('Coprocessor enabled');
  411.             yesorno(equip and $0002 = $0002);
  412.             writeln;
  413.             caption2('DMA installed (PCjr)');
  414.             yesorno(equip and $0100 = $0000)
  415.           end;
  416.           2 : begin
  417.             caption2('Total conventional memory (bytes)');
  418.             writeln(dosmem : 6);
  419.             caption2('Free conventional memory (bytes) ');
  420.             writeln(dosmem - $10 * longint(prefixseg) : 6);
  421.             caption2('Extended memory (bytes)        ');
  422.             if intinit(cassetteint) then begin
  423.               AH := $88;
  424.               intr(cassetteint, regs);
  425.               if nocarry then
  426.                 writeln($400 * longint(AX) : 8)
  427.               else
  428.                 writeln('N/A' : 8);
  429.             end else
  430.               writeln('N/A' : 8);
  431.             caption2('Expanded memory');
  432.             if intinit(EMMint) then begin
  433.               writeln;
  434.               caption2(qindent + 'Interrupt vector');
  435.               Xword1 := intseg[EMMint];
  436.               segofs(xword1, intofs[EMMint]);
  437.               writeln;
  438.               caption2(qindent + 'Driver');
  439.               xstring := '';
  440.               for i := $000A to $0011 do
  441.                 xstring := xstring + showchar(chr(mem[xword1 : i]));
  442.               write(xstring);
  443.               if xstring = qEMMdrvr then begin
  444.                 writeln;
  445.                 caption2(qindent + 'Manager status');
  446.                 AH := $40;
  447.                 intr(EMMint, regs);
  448.                 if AH = $00 then
  449.                   writeln('OK')
  450.                 else
  451.                   EMMerr(AH);
  452.                 caption2(qindent + 'Page frame segment');
  453.                 AH := $41;
  454.                 intr(EMMint, regs);
  455.                 if AH = $00 then
  456.                   writeln(hex(BX, 4))
  457.                 else
  458.                   EMMerr(AH);
  459.                 caption2(qindent + 'Total EMS memory (16K pages)');
  460.                 AH := $42;
  461.                 intr(EMMint, regs);
  462.                 if AH = $00 then
  463.                   writeln(DX : 3)
  464.                 else
  465.                   EMMerr(AH);
  466.                 caption2(qindent + 'Free EMS memory (16K pages) ');
  467.                 if AH = $00 then
  468.                   writeln(BX : 3)
  469.                 else
  470.                   EMMerr(AH);
  471.                 caption2(qindent + 'EMM version');
  472.                 AH := $46;
  473.                 intr(EMMint, regs);
  474.                 if AH = $00 then
  475.                   writeln(AL shr 4, '.', AL and $0F)
  476.                 else
  477.                   EMMerr(AH);
  478.                 caption1(qindent + 'Handle' + qspace3 + '16K pages');
  479.                 writeln;
  480.                 AH := $4D;
  481.                 ES := seg(EMMarray);
  482.                 DI := ofs(EMMarray);
  483.                 intr(EMMint, regs);
  484.                 if AH = $00 then
  485.                   if BX > $0000 then begin
  486.                     topline:= 15;
  487.                     window(1 + lqindent, topline, twidth, tlength - 2);
  488.                     for i := 1 to BX do begin
  489.                       pause;
  490.                       writeln(hex(EMMarray[2 * i - 2], 4), '  ', qspace3
  491.                         , EMMarray[2 * i - 1] : 3)
  492.                     end
  493.                   end else
  494.                     writeln(qindent, '(no active handles)')
  495.                 else
  496.                   EMMerr(AH)
  497.               end else
  498.                 writeln(' (unknown driver)')
  499.             end else
  500.               writeln('(none)')
  501.           end;
  502.           3 : begin
  503.             caption1('MCB ' + qspace3 + 'PSP ' + qspace3 + 'Parent' + qspace3
  504.               + '  Size' + qspace3 + 'Owner       ' + qspace3 + 'Interrupts');
  505.             writeln;
  506.             topline := 4;
  507.             window(1, topline, twidth, tlength - 2);
  508.             xword1 := memw[devseg : devofs - $02];
  509.             (*   BIX ms.dos/secrets #1032   *)
  510.             xbool2 := false;
  511.             repeat
  512.               xbyte1 := mem[xword1 : $0000];
  513.               xword2 := memw[xword1 : $0001];
  514.               xword3 := memw[xword2 : $0016];
  515.               pause;
  516.               case xbyte1 of
  517.                 $4D : begin
  518.                   xword4 := memw[xword1 : $0003];
  519.                   showMCB(xword1, xword2, xword3, xword4);
  520.                   inc(xword1, 1 + xword4)
  521.                 end;
  522.                 $5A : begin
  523.                   xword4 := dosmem shr 4 - xword1 - 1;
  524.                   showMCB(xword1, xword2, xword3, xword4);
  525.                   xbool2 := true
  526.                 end else begin
  527.                   unknown('MCB status', xbyte1, 2);
  528.                   xbool2 := true
  529.                 end
  530.               end
  531.             until xbool2
  532.           end;
  533.           (*   PC Magazine 6:14 p.425   *)
  534.           4 : begin
  535.             caption2('Display adapter');
  536.             case graphdriver of
  537.               CGA : writeln('CGA');
  538.               MCGA : writeln('MCGA');
  539.               EGA..EGAmono : begin
  540.                 writeln('EGA');
  541.                 caption2(qindent + 'BIOS source');
  542.                 showBIOS(EGABIOS1, EGABIOS2);
  543.                 xbyte1 := mem[BIOSseg : $0087];
  544.                 caption1(qindent + 'Screen buffer ');
  545.                 if (xbyte1 and $80) = $00 then
  546.                   write('cleared')
  547.                 else
  548.                   write('preserved');
  549.                 caption1(' during last mode change');
  550.                 writeln;
  551.                 caption2(qindent + 'Memory');
  552.                 case xbyte1 and $60 of
  553.                   $00 : writeln('64K');
  554.                   $20 : writeln('128K');
  555.                   $40 : writeln('192K');
  556.                   $60 : writeln('256K')
  557.                 end;
  558.                 caption2(qindent + 'EGA active');
  559.                 yesorno(xbyte1 and $08 = $00);
  560.                 writeln;
  561.                 caption2(qindent + 'Wait for display enable');
  562.                 yesorno(xbyte1 and $04 = $04);
  563.                 writeln;
  564.                 caption2(qindent + 'Attached display');
  565.                 if (xbyte1 and $02) = $00 then
  566.                   writeln('color')
  567.                 else
  568.                   writeln('monochrome');
  569.                 caption2(qindent + 'CGA cursor emulation');
  570.                 yesorno(xbyte1 and $01 = $00);
  571.                 writeln;
  572.                 (*   PC Magazine 6:12 p.326   *)
  573.                 caption2(qindent + 'Scan lines/character');
  574.                 AX := $1130;
  575.                 intr($10, regs);
  576.                 writeln(CX);
  577.                 (*   PC Magazine 6:17 p.424   *)
  578.                 xbyte1 := mem[BIOSseg : $0088];
  579.                 caption2(qindent + 'Feature bits');
  580.                 writeln(bin4(xbyte1 shr 4));
  581.                 caption2(qindent + 'DIP switches');
  582.                 writeln(bin4(xbyte1 and $0F));
  583.                 (*   PC Tech Journal 3:4 p.65   *)
  584.                 xword1 := memw[BIOSseg : $00AA];
  585.                 xword2 := memw[BIOSseg : $00A8];
  586.                 caption2(qindent + 'Save area                    ');
  587.                 segofs(xword1, xword2);
  588.                 writeln;
  589.                 (*   PC Tech Journal 3:4 p.65   *)
  590.                 caption2(qindent + 'Video parameter table        ');
  591.                 segofs(memw[xword1 : xword2 +  2], memw[xword1 : xword2]);
  592.                 writeln;
  593.                 caption2(qindent + 'Dynamic save area            ');
  594.                 xword3 := memw[xword1 : xword2 +  6];
  595.                 xword4 := memw[xword1 : xword2 +  4];
  596.                 if (xword3 > $0000) or (xword4 > $0000) then begin
  597.                   segofs(xword3, xword4);
  598.                   writeln
  599.                 end else
  600.                   writeln('(none)');
  601.                 caption2(qindent + 'Auxiliary character generator');
  602.                 xword3 := memw[xword1 : xword2 + 10];
  603.                 xword4 := memw[xword1 : xword2 +  8];
  604.                 if (xword3 > $0000) or (xword4 > $0000) then begin
  605.                   segofs(xword3, xword4);
  606.                   writeln
  607.                 end else
  608.                   writeln('(none)');
  609.                 caption2(qindent + 'Graphics mode auxiliary table');
  610.                 xword3 := memw[xword1 : xword2 + 14];
  611.                 xword4 := memw[xword1 : xword2 + 12];
  612.                 if (xword3 > $0000) or (xword4 > $0000) then begin
  613.                   segofs(xword3, xword4);
  614.                   writeln
  615.                 end else
  616.                   writeln('(none)')
  617.                 (*   PC Tech Journal 3:4 p.67   *)
  618.               end;
  619.               hercmono : writeln('Hercules or MDA');
  620.               ATT400 : writeln('AT&T 400');
  621.               VGA : begin
  622.                 writeln('VGA');
  623.                 caption2(qindent + 'Active display');
  624.                 case BL of
  625.                   $07 :  writeln('analog monochrome');
  626.                   $08 :  writeln('analog color')
  627.                   else
  628.                     unknown('display type', BL, 2)
  629.                 end
  630.               end;
  631.               (*   PC Magazine 6:19 p.480   *)
  632.               PC3270 : writeln('3270 PC')
  633.               else
  634.                 unknown('adapter', graphdriver, 4)
  635.             end
  636.           end;
  637.           5 : begin
  638.             caption2('Initial video mode');
  639.             case equip and $30 of
  640.               $00 : writeln('No display');
  641.               $10 : writeln('40 x 25 color');
  642.               $20 : writeln('80 x 25 color');
  643.               $30 : writeln('80 x 25 monochrome')
  644.             end;
  645.             caption2('Current video mode');
  646.             xbyte1 := lo(lastmode);
  647.             write(xbyte1, ' ');
  648.             case xbyte1 of
  649.               0 : writeln('(40 x 25 b/w text)');
  650.               1 : writeln('(40 x 25 color text)');
  651.               2 : writeln('(80 x 25 b/w text)');
  652.               3 : writeln('(80 x 25 color text)');
  653.               4 : writeln('(320 x 200 4 colors)');
  654.               5 : writeln('(320 x 200 4 colors, no color burst)');
  655.               6 : writeln('(640 x 200 2 colors)');
  656.               7 : writeln('(MDA text)');
  657.               8 : writeln('(160 x 200 16 colors)');
  658.               9 : writeln('(320 x 200 16 colors)');
  659.               10 : writeln('(640 x 200 4 colors)');
  660.               13 : writeln('(320 x 200 16 colors)');
  661.               14 : writeln('(640 x 200 16 colors)');
  662.               15 : writeln('(640 x 350 monochrome)');
  663.               16 : writeln('(640 x 350 16 colors)');
  664.               17 : writeln('(640 x 480 2 colors)');
  665.               18 : writeln('(640 x 480 16 colors)');
  666.               19 : writeln('(640 x 480 256 colors)')
  667.               else
  668.                 unknown('video mode', xbyte1, 2)
  669.             end;
  670.             (*   Byte 12:12 p. 176D   *)
  671.             caption2('Valid graphics modes');
  672.             getmoderange(graphdriver, xint1, xint2);
  673.             writeln(xint1, '-', xint2);
  674.             caption2('Video buffer (offset)');
  675.             writeln(hex(memw[BIOSseg : $004E], 4));
  676.             (*   PC Magazine 6:8 p.290   *)
  677.             caption2('Video buffer size (bytes)');
  678.             writeln(memw[BIOSseg : $004C]);
  679.             (*   PC Magazine 6:8 p.290   *)
  680.             caption2('Active display port');
  681.             xword1 := memw[BIOSseg : $0063];
  682.             write(qhexpref, hex(xword1, 3), ' ');
  683.             if xword1 = $3B4 then
  684.               writeln('(monochrome)')
  685.             else if xword1 = $3D4 then
  686.               writeln('(color)')
  687.             else
  688.               dontknow;
  689.             (*   PC Magazine 6:8 p.290   *)
  690.             caption2('CRT mode register');
  691.             writeln(qhexpref, hex(mem[BIOSseg : $0065], 2));
  692.             (*   PC Magazine 6:8 p.290   *)
  693.             caption2('Current palette');
  694.             writeln(qhexpref, hex(mem[BIOSseg : $0066], 2), qindent);
  695.             (*   PC Magazine 6:8 p.290   *)
  696.             caption2('Colors');
  697.             caption1('·');
  698.             for i := black to white do begin
  699.               textcolor(i);
  700.               write('█')
  701.             end;
  702.             caption1('·');
  703.             writeln;
  704.             caption2('Current display page');
  705.             writeln(vidpg);
  706.             caption2('Text rows   ');
  707.             writeln(tlength);
  708.             caption2('Text columns');
  709.             writeln(twidth);
  710.             caption2('Current colors');
  711.             if (attrsave and $80) = $80 then
  712.               write('blinking ');
  713.             showcolor(attrsave and $0F);
  714.             write(' on ');
  715.             showcolor(attrsave and $70 shr 4);
  716.             writeln;
  717.             caption2('Cursor scan lines');
  718.             AH := $03;
  719.             BH := vidpg;
  720.             intr($10, regs);
  721.             writeln(CH, '-', CL)
  722.           end;
  723.           6 : begin
  724.             caption2('Keyboard');
  725.             writeln;
  726.             AH := $02;
  727.             intr($16, regs);
  728.             caption2(qindent + 'Insert');
  729.             offoron(AL and $80);
  730.             caption2(qspace7 + 'Caps Lock');
  731.             offoron(AL and $40);
  732.             caption2(qspace7 + 'Num Lock');
  733.             offoron(AL and $20);
  734.             caption2(qspace7 + 'Scroll Lock');
  735.             offoron(AL and $10);
  736.             writeln;
  737.             caption2(qindent + 'Buffer');
  738.             xword1 := memw[BIOSseg : $0080];
  739.             segofs(BIOSseg, xword1);
  740.             xword2 := memw[BIOSseg : $0082];
  741.             writeln('-', hex(xword2, 4));
  742.             (*   PC Magazine 6:8 p.290   *)
  743.             caption2(qindent + 'Buffer size (keystrokes)');
  744.             writeln((xword2 - xword1) shr 1 - 1);
  745.             caption2(qindent + 'BIOS support for enhanced keyboard');
  746.             AH := $02;
  747.             intr($16, regs);
  748.             xbyte1 := AL;
  749.             AX := $1200 + xbyte1 xor $FF;
  750.             intr($16, regs);
  751.             if AL = xbyte1 then begin
  752.               writeln('yes');
  753.               caption2(qindent + 'Enhanced keyboard present');
  754.               yesorno(mem[BIOSseg : $0096] and $10 = $10);
  755.               writeln
  756.             end else
  757.               writeln('no');
  758.             (*   PC Magazine 6:15 p.378   *)
  759.             caption2('Printers');
  760.             xbyte1 := equip and $C000 shr 14;
  761.             writeln(xbyte1);
  762.             if xbyte1 > 0 then begin
  763.               if xbyte1 > 3 then
  764.                 xbyte1 := 3;
  765.               caption1(qindent + 'Device' + qspace2 + 'Addr' + qspace2
  766.                 + 'Timeout' + qspace2 + 'Busy' + qspace2 + 'Ack' + qspace2
  767.                 + 'Paper out' + qspace2 + 'Selected' + qspace2+ 'I/O error'
  768.                 + qspace2 + 'Timed out');
  769.               writeln;
  770.               for i := 1 to xbyte1 do begin
  771.                 write(qindent, 'LPT', i, '  ', qspace2, qhexpref
  772.                   , hex(memw[BIOSseg : 2 * i + 6], 3), qspace2
  773.                   , mem[BIOSseg : $0077 + i] : 3, '    ', qspace2);
  774.                 AH := $02;
  775.                 DX := i - 1;
  776.                 intr($17, regs);
  777.                 yesorno(AH and $80 = $00);
  778.                 write(' ', qspace2);
  779.                 yesorno(AH and $40 = $40);
  780.                 write(qspace2);
  781.                 yesorno(AH and $20 = $20);
  782.                 write('      ', qspace2);
  783.                 yesorno(AH and $10 = $10);
  784.                 write('     ', qspace2);
  785.                 yesorno(AH and $08 = $08);
  786.                 write('      ', qspace2);
  787.                 yesorno(AH and $01 = $01);
  788.                 writeln
  789.               end
  790.             end;
  791.             (*   PC Magazine 6:8 p.290   *)
  792.             caption2('Serial ports');
  793.             xbyte1 := equip and $0E00 shr 9;
  794.             writeln(xbyte1);
  795.             if xbyte1 > 0 then begin
  796.               if xbyte1 > 4 then
  797.                 xbyte1 := 4;
  798.               caption1(qindent + 'Device' + qspace3 + 'Addr' + qspace3
  799.                 + 'Timeout' + qspace3 + 'RLSD' + qspace3 + 'RI ' + qspace3
  800.                 + 'DSR' + qspace3 + 'CTS' + qspace3 + 'dRLSD' + qspace3
  801.                 + '-dRI' + qspace3 + 'dDSR' + qspace3 + 'dCTS');
  802.               writeln;
  803.               for i := 1 to xbyte1 do begin
  804.                 write(qindent, 'COM', i, '  ', qspace3, qhexpref
  805.                   , hex(memw[BIOSseg : 2 * i - 2], 3), qspace3
  806.                   , mem[BIOSseg : $007B + i] : 3, '    ', qspace3);
  807.                 AH := $03;
  808.                 DX := i - 1;
  809.                 intr($14, regs);
  810.                 yesorno(AL and $80 = $80);
  811.                 write(' ', qspace3);
  812.                 yesorno(AL and $40 = $40);
  813.                 write(qspace3);
  814.                 yesorno(AL and $20 = $20);
  815.                 write(qspace3);
  816.                 yesorno(AL and $10 = $10);
  817.                 write(qspace3);
  818.                 yesorno(AL and $08 = $08);
  819.                 write('  ', qspace3);
  820.                 yesorno(AL and $04 = $04);
  821.                 write(' ', qspace3);
  822.                 yesorno(AL and $02 = $02);
  823.                 write(' ', qspace3);
  824.                 yesorno(AL and $01 = $01);
  825.                 writeln
  826.               end
  827.             end;
  828.             (*   PC Magazine 6:8 p.290   *)
  829.             caption2('Game port');
  830.             yesorno(equip and $1000 = $1000);
  831.             writeln;
  832.             caption2('Mouse');
  833.             if intinit(mouseint) then begin
  834.               writeln;
  835.               caption2(qindent + 'Interrupt vector');
  836.               segofs(intseg[mouseint], intofs[mouseint]);
  837.               writeln;
  838.               caption2(qindent + 'Status');
  839.               AX := 0;
  840.               intr(mouseint, regs);
  841.               if AX = $FFFF then begin
  842.                 writeln('present');
  843.                 caption2(qindent + 'Buttons');
  844.                 if BX = $0000 then
  845.                   write(3)
  846.                 else if BX = $FFFF then
  847.                   write(2)
  848.                 else
  849.                   write('(unknown button count description word', hex(BX, 4)
  850.                     , ')');
  851.               end else if AX = $0000 then
  852.                 writeln('not present')
  853.               else
  854.                 unknown('status', AX, 4)
  855.             end else
  856.               writeln('no');
  857.             (*   PC Magazine 6:13 p.420   *)
  858.             caption2('Serial printer (PCjr)');
  859.             yesorno(equip and $2000 = $2000);
  860.             writeln
  861.           end;
  862.           7 : begin
  863.             window(1, 3, twidth shr 1, tlength - 2);
  864.             caption2('DOS version');
  865.             showvers;
  866.             caption2('System date');
  867.             getdate(xword1, xword2, xword3, xword4);
  868.             if xword4 = 0 then
  869.               write('Sunday')
  870.             else if xword4 = 1 then
  871.               write('Monday')
  872.             else if xword4 = 2 then
  873.               write('Tuesday')
  874.             else if xword4 = 3 then
  875.               write('Wednesday')
  876.             else if xword4 = 4 then
  877.               write('Thursday')
  878.             else if xword4 = 5 then
  879.               write('Friday')
  880.             else if xword4 = 6 then
  881.               write('Saturday')
  882.             else
  883.               write('(', hex(xword4, 4), ')');
  884.             write(', ');
  885.             xword5 := cbw(country[1], country[0]);
  886.             xchar1 := chr(country[11]);
  887.             if xword5 = $0000 then
  888.               writeln(xword2, xchar1, xword3, xchar1, xword1)
  889.             else if xword5 = $0001 then
  890.               writeln(xword3, xchar1, xword2, xchar1, xword1)
  891.             else if xword5 = $0002 then
  892.               writeln(xword1, xchar1, xword2, xchar1, xword3)
  893.             else
  894.               writeln(xword2, xchar1, xword3, xchar1, xword1);
  895.             caption2('System time');
  896.             gettime(xword1, xword2, xword3, xword4);
  897.             zeropad(xword1);
  898.             write(chr(country[13]));
  899.             zeropad(xword2);
  900.             write(chr(country[13]));
  901.             zeropad(xword3);
  902.             write(chr(country[9]));
  903.             zeropad(xword4);
  904.             writeln;
  905.             caption2('Command load paragraph');
  906.             writeln(hex(prefixseg, 4));
  907.             caption2('Ctrl-C check');
  908.             AX := $3300;
  909.             MSDOS(regs);
  910.             if DL = $00 then
  911.               writeln('off')
  912.             else if DL = $01 then
  913.               writeln('on')
  914.             else
  915.               unknown('status', DL, 2);
  916.             caption2('Disk verify');
  917.             AH := $54;
  918.             MSDOS(regs);
  919.             if AL = $00 then
  920.               writeln('off')
  921.             else if AL = $01 then
  922.               writeln('on')
  923.             else
  924.               unknown('status', AL, 2);
  925.             caption2('Switch prefix character');
  926.             AX := $3700;
  927.             MSDOS(regs);
  928.             writeln(chr(DL));
  929.             (*   BIX ms.dos/secrets #1130   *)
  930.             caption2('\DEV\ prefix for devices');
  931.             AX := $3702;
  932.             MSDOS(regs);
  933.             if DL = $00 then
  934.               writeln('required')
  935.             else
  936.               writeln('optional');
  937.             (*   BIX ms.dos/secrets #1130   *)
  938.             caption2('Reset boot');
  939.             xword1 := memw[BIOSseg : $72];
  940.             if xword1 = $0000 then
  941.               writeln('cold')
  942.             else if xword1 = $1234 then
  943.               writeln('bypass memory test')
  944.             else if xword1 = $4321 then
  945.               writeln('preserve memory')
  946.             else if xword1 = $5678 then
  947.               writeln('system suspended')
  948.             else if xword1 = $9ABC then
  949.               writeln('manufacturing test mode')
  950.             else if xword1 = $ABCD then
  951.               writeln('system POST loop mode')
  952.             else
  953.               unknown('flag', xword1, 4);
  954.             (*   Byte 12:12 p.178   *)
  955.             caption2('DOS busy flag');
  956.             segofs(DOScseg, DOScofs);
  957.             writeln;
  958.             caption2('Printer echo');
  959.             case osmajor of
  960.               3 : case osminor div 10 of
  961.                 0 : dontknow;
  962.                 1..3 : showecho($02AC)
  963.                 else
  964.                   dontknow
  965.               end else
  966.                 dontknow
  967.             end;
  968.             (*   BIX ms.dos/secrets #501   *)
  969.             caption2('PrtSc status');
  970.             xbyte1 := mem[BIOSseg : $0100];
  971.             case xbyte1 of
  972.               $00 : writeln('ready');
  973.               $01 : writeln('busy');
  974.               $FF : writeln('error on last PrtSc')
  975.               else
  976.                 unknown('status', xbyte1, 2)
  977.             end;
  978.             (*   PC Magazine 6:20 p.412   *)
  979.             caption2('Memory allocation');
  980.             AX := $5800;
  981.             MSDOS(regs);
  982.             if AX = $0000 then
  983.               writeln('first fit')
  984.             else if AX = $0001 then
  985.               writeln('best fit')
  986.             else if AX = $0002 then
  987.               writeln('last fit')
  988.             else
  989.               unknown('strategy', AX, 4);
  990.             caption2('DOS buffers');
  991.             case osmajor of
  992.               3 : case osminor div 10 of
  993.                 0 : showbufs($013F);
  994.                 1..3 : showbufs($0038)
  995.                 else
  996.                   dontknow
  997.               end else
  998.                 dontknow
  999.             end;
  1000.             caption2('File handle table ');
  1001.             xword1 := memw[prefixseg : $0036];
  1002.             xword2 := memw[prefixseg : $0034];
  1003.             segofs(xword1, xword2);
  1004.             writeln;
  1005.             caption2('File handle table length');
  1006.             writeln(mem[prefixseg : $0032] : 3);
  1007.             caption2('File handles used       ');
  1008.             i := 0;
  1009.             while mem[xword1 : xword2] < $FF do begin
  1010.               inc(i);
  1011.               inc(xword2)
  1012.             end;
  1013.             writeln(i : 3);
  1014.             xstring := 'File handles free ';
  1015.             findfirst('*.*', archive, search);
  1016.             if doserror = 0 then begin
  1017.               i := 0;
  1018.               xbool2 := false;
  1019.               repeat
  1020.                 if i < filesmax then begin
  1021.                   assign(f[i + 1], search.name);
  1022.                   reset(f[i + 1]);
  1023.                   if ioresult = 0 then
  1024.                     inc(i)
  1025.                   else begin
  1026.                     xbool2 := true;
  1027.                     caption2(xstring + '      ');
  1028.                     writeln(i : 3)
  1029.                   end
  1030.                 end else begin
  1031.                   xbool2 := true;
  1032.                   caption2(xstring);
  1033.                   dontknow
  1034.                 end
  1035.               until xbool2;
  1036.               for j := 1 to i do
  1037.                 close(f[j])
  1038.             end else begin
  1039.               caption2(xstring);
  1040.               dontknow
  1041.             end;
  1042.             caption2('Global code page');
  1043.             AX := $6601;
  1044.             MSDOS(regs);
  1045.             if AL = $01 then begin
  1046.               writeln;
  1047.               caption2(qindent + 'Active ');
  1048.               writeln(BX : 5);
  1049.               caption2(qindent + 'Default');
  1050.               write(DX : 5)
  1051.             end else
  1052.               writeln('N/A');
  1053.             (*   PC Magazine 6:13 p. 181   *)
  1054.             window(1 + twidth shr 1, 3, twidth, tlength - 2);
  1055.             caption2('Country code');
  1056.             writeln(ccode);
  1057.             caption2('Thousands separator character');
  1058.             writeln(chr(country[7]));
  1059.             caption2('Decimal separator character');
  1060.             writeln(chr(country[9]));
  1061.             caption2('Data-list separator character');
  1062.             writeln(chr(country[22]));
  1063.             caption2('Date format');
  1064.             xword1 := cbw(country[1], country[0]);
  1065.             xchar1 := chr(country[11]);
  1066.             if xword1 = $0000 then
  1067.               writeln('USA (mm', xchar1, 'dd', xchar1, 'yy)')
  1068.             else if xword1 = $0001 then begin
  1069.               writeln('Europe (dd', xchar1, 'mm', xchar1, 'yy)')
  1070.             end else if xword1 = $0002 then begin
  1071.               writeln('Japan (yy', xchar1, 'mm', xchar1, 'dd)')
  1072.             end else
  1073.               unknown('format', xword1, 4);
  1074.             caption2(qindent + 'Separator character');
  1075.             writeln(xchar1);
  1076.             caption2('Time format');
  1077.             if (country[17] and $01) = $00 then
  1078.               write('12')
  1079.             else
  1080.               write('24');
  1081.             writeln('-hour');
  1082.             caption2(qindent + 'Separator character');
  1083.             writeln(chr(country[13]));
  1084.             caption2('Currency format');
  1085.             writeln;
  1086.             caption2(qindent + 'Currency symbol string');
  1087.             i := 2;
  1088.             xchar1 := chr(country[i]);
  1089.             while xchar1 > #0 do begin
  1090.               write(xchar1);
  1091.               inc(i);
  1092.               xchar1 := chr(country[i])
  1093.             end;
  1094.             writeln;
  1095.             caption1(qindent + 'Currency symbol ');
  1096.             if (country[15] and $01) = $00 then
  1097.               write('precedes')
  1098.             else
  1099.               write('follows');
  1100.             caption1(' value');
  1101.             writeln;
  1102.             caption2(qindent + 'Spaces between symbol and value');
  1103.             writeln(country[15] shr 1 and 1);
  1104.             caption2(qindent + 'Digits after decimal');
  1105.             writeln(country[16]);
  1106.             caption2('Case map call address');
  1107.             segofs(cbw(country[21], country[20]), cbw(country[19]
  1108.               , country[18]));
  1109.             writeln
  1110.           end;
  1111.           8 : begin
  1112.             caption2('Multiplex interrupt ($2F)');
  1113.             writeln;
  1114.             muxint('PRINT          ', $01);
  1115.             (*   Byte 12:12 p. 176C   *)
  1116.             muxint('ASSIGN         ', $06);
  1117.             (*
  1118.             **   Byte 12:12 p. 176C, Duncan, and many others, all of whom
  1119.             **   mistakenly give AH = $02
  1120.             *)
  1121. (*
  1122.             muxint('DRIVER.SYS     ', $08);
  1123. *)
  1124.             muxint('SHARE          ', $10);
  1125.             (*   Byte 12:12 p. 176C   *)
  1126. (*
  1127.             muxint('FASTOPEN       ', $12);
  1128. *)
  1129.             muxint('NLSFUNC        ', $14);
  1130.             muxint('GRAFTABL       ', $B0);
  1131. (*
  1132.             muxint('DISPLAY.SYS    ', $B0);
  1133. *)
  1134.             muxint('APPEND         ', $B7);
  1135.             (*   Byte 12:12 p. 176C   *)
  1136. (*
  1137.             muxint('KEYB           ', $B8);
  1138. *)
  1139.             muxint('NETBIOS append ', $87);
  1140.             muxint('NETBIOS network', $88);
  1141.             (*   Byte 12:12 p. 180   *)
  1142.             (*   PC Tech Journal 3:11 p.104 gives AH = $BB   *)
  1143.             caption2('Environment');
  1144.             writeln;
  1145.             topline := 13;
  1146.             window(1 + lqindent, topline, twidth, tlength - 2);
  1147.             xword1 := memw[prefixseg : $002C];
  1148.             i := $0000;
  1149.             xbyte1 := mem[xword1 : i];
  1150.             xbool2 := false;
  1151.             repeat
  1152.               inc(i);
  1153.               xbyte2 := mem[xword1 : i];
  1154.               if xbyte1 > $00 then
  1155.                 write(chr(xbyte1))
  1156.               else if xbyte2 > $00 then begin
  1157.                 writeln;
  1158.                 pause
  1159.               end else
  1160.                 xbool2 := true;
  1161.               xbyte1 := xbyte2
  1162.             until xbool2
  1163.           end;
  1164.           9 : begin
  1165.             caption1('Device  ' + qspace4 + 'Units' + qspace4 + 'Header   '
  1166.               + qspace4 + 'Attributes         ' + qspace4 + 'Strategy '
  1167.               + qspace4 + 'Interrupt');
  1168.             writeln;
  1169.             if scan(nuldev, devseg, devofs, devofs + $100, xword1) then begin
  1170.               xword2 := devseg;
  1171.               xword3 := xword1 - 10;
  1172.               topline := 4;
  1173.               window(1, topline, twidth, tlength - 2);
  1174.               while xword3 < $FFFF do begin
  1175.                 pause;
  1176.                 for i := 0 to 17 do
  1177.                   header[i] := mem[xword2 : xword3 + i];
  1178.                 if header[5] and $80 = 0 then
  1179.                   write('        ', qspace4, header[10] : 5)
  1180.                 else begin
  1181.                   for i := 10 to 17 do
  1182.                     write(showchar(chr(header[i])));
  1183.                   write(qspace4, '     ')
  1184.                 end;
  1185.                 write(qspace4);
  1186.                 segofs(xword2, xword3);
  1187.                 write(qspace4, bin16(cbw(header[5], header[4])), qspace4);
  1188.                 segofs(xword2, cbw(header[7], header[6]));
  1189.                 write(qspace4);
  1190.                 segofs(xword2, cbw(header[9], header[8]));
  1191.                 writeln;
  1192.                 xword2 := cbw(header[3], header[2]);
  1193.                 xword3 := cbw(header[1], header[0])
  1194.               end
  1195.             end else
  1196.               writeln('(can''t find NUL device header)')
  1197.             (*   BIX ms.dos/secrets #1032   *)
  1198.           end;
  1199.           10 : begin
  1200.             caption2('Logical drives');
  1201.             for xchar1 := 'A' to 'Z' do begin
  1202.               AH := $0E;
  1203.               DL := ord(xchar1) - ord('A');
  1204.               MSDOS(regs);
  1205.               AH := $19;
  1206.               MSDOS(regs);
  1207.               if AL = DL then
  1208.                 drvname(AL)
  1209.             end;
  1210.             writeln;
  1211.             AH := $0E;
  1212.             DL := currdrv;
  1213.             MSDOS(regs);
  1214.             caption2('Diskette drives');
  1215.             if equip and $0001 = $0001 then
  1216.               writeln(1 + equip and $00C0 shr 6)
  1217.             else
  1218.               writeln(0);
  1219.             xword1 := intseg[$1E];
  1220.             xword2 := intofs[$1E];
  1221.             caption2(qindent + 'Sectors/track');
  1222.             writeln(mem[xword1 : xword2 + 4]);
  1223.             caption2(qindent + 'Bytes/sector');
  1224.             writeln($100 * longint(mem[xword1 : xword2 + 3]));
  1225.             caption2(qindent + 'On time (ms)');
  1226.             writeln(125 * mem[xword1 : xword2 + 10]);
  1227.             caption2(qindent + 'Off time (s)');
  1228.             writeln(mem[xword1 : xword2 + 2] * tickrate / 1000 : 0 : 1);
  1229.             caption2(qindent + 'Settling time (ms)');
  1230.             writeln(mem[xword1 : xword2 + 9]);
  1231.             caption1(qindent + 'Single drive is now ');
  1232.             xbyte1 := mem[BIOSseg : $0104];
  1233.             if xbyte1 <= ord('Z') - ord('A') then begin
  1234.               drvname(xbyte1);
  1235.               writeln
  1236.             end else if xbyte1 = $FF then
  1237.               writeln('N/A')
  1238.             else
  1239.               unknown('status', xbyte1, 2);
  1240.             (*   Byte 12:12 p.178   *)
  1241.             caption2('Fixed disk controller BIOS source');
  1242.             showBIOS(HDCBIOS1, HDCBIOS2);
  1243.             caption2('Current drive and path');
  1244.             getdir(0, xstring);
  1245.             writeln(xstring);
  1246.             caption2(qindent + 'Volume label');
  1247.             findfirst('\*.*', volumeid, search);
  1248.             if doserror = 0 then
  1249.               writeln(search.name)
  1250.             else
  1251.               writeln('(none)');
  1252.             AH := $1B;
  1253.             MSDOS(regs);
  1254.             media(mem[DS : BX]);
  1255.             caption2(qindent + 'Clusters');
  1256.             writeln(DX);
  1257.             caption2(qindent + 'Sectors/cluster');
  1258.             writeln(AL);
  1259.             caption2(qindent + 'Bytes/sector');
  1260.             writeln(CX);
  1261.             caption2(qindent + 'Total space (bytes)');
  1262.             xlongint := disksize(currdrv + 1);
  1263.             if xlongint <> -1 then
  1264.               writeln(xlongint : 8)
  1265.             else
  1266.               writeln('(invalid drive)');
  1267.             caption2(qindent + 'Free space (bytes) ');
  1268.             xlongint := diskfree(currdrv + 1);
  1269.             if xlongint <> -1 then
  1270.               writeln(xlongint : 8)
  1271.             else
  1272.               writeln('(invalid drive)')
  1273.           end;
  1274.           11 : begin
  1275.             caption2('BIOS disk parameters');
  1276.             writeln;
  1277.             caption1(qindent + 'Type          ' + qspace4 + 'Unit #' + qspace4
  1278.               + 'Quantity' + qspace4 + 'Heads' + qspace4 + 'Cylinders'
  1279.               + qspace4 + 'Sectors/track');
  1280.             writeln;
  1281.             topline := 5;
  1282.             window(1 + lqindent, topline, twidth, tlength - 2);
  1283.             drvparms($00, 'diskette drive');
  1284.             drvparms($80, 'fixed disk    ')
  1285.             (*   PC Magazine 7:5 p.339   *)
  1286.           end;
  1287.           12 : begin
  1288.             window(1, 3, twidth, tlength - 2);
  1289.             caption2('DOS disk parameter block');
  1290.             writeln;
  1291.             AX := $3200;
  1292.             DX := $0000;
  1293.             MSDOS(regs);
  1294.             if AL = $00 then begin
  1295.               caption2(qindent + 'Drive');
  1296.               drvname(mem[DS : BX]);
  1297.               writeln;
  1298.               caption2(qindent + 'Unit within driver');
  1299.               writeln(mem[DS : BX + $01] + 1);
  1300.               caption2(qindent + 'Bytes/sector');
  1301.               writeln(memw[DS : BX + $02]);
  1302.               caption2(qindent + 'Sectors/cluster');
  1303.               writeln(mem[DS : BX + $04] + 1);
  1304.               caption2(qindent + 'Cluster to sector shift');
  1305.               writeln(mem[DS : BX + $05]);
  1306.               caption2(qindent + 'Reserved (boot) sectors');
  1307.               writeln(memw[DS : BX + $06]);
  1308.               caption2(qindent + 'FAT''s');
  1309.               writeln(mem[DS : BX + $08]);
  1310.               caption2(qindent + 'Root directory entries');
  1311.               writeln(memw[DS : BX + $09]);
  1312.               caption2(qindent
  1313.                 + 'First data sector');
  1314.               writeln(memw[DS : BX + $0B]);
  1315.               caption2(qindent + 'Clusters');
  1316.               writeln(memw[DS : BX + $0D] - 1);
  1317.               caption2(qindent + 'Sectors/FAT');
  1318.               writeln(mem[DS : BX + $0F]);
  1319.               caption2(qindent + 'Root directory sector');
  1320.               writeln(memw[DS : BX + $10]);
  1321.               caption2(qindent + 'Device header');
  1322.               segofs(memw[DS : BX + $14], memw[DS : BX + $12]);
  1323.               writeln;
  1324.               media(mem[DS : BX + $16]);
  1325.               caption2(qindent + 'Next disk block');
  1326.               segofs(memw[DS : BX + $1A], memw[DS : BX + $18]);
  1327.               writeln
  1328.             end else
  1329.               writeln('Function 32H error ', hex(AL, 2));
  1330.             window(1 + twidth shr 1, 3, twidth, tlength - 2);
  1331.             if bootstat = $0000 then begin
  1332.               caption1('Boot record of drive ');
  1333.               drvname(currdrv);
  1334.               writeln;
  1335.               caption2(qindent + 'OEM name and version');
  1336.               for i := $03 to $0A do
  1337.                 write(showchar(chr(bootrec[i])));
  1338.               writeln;
  1339.               caption2(qindent + 'Bytes/sector');
  1340.               writeln(cbw(bootrec[$0C], bootrec[$0B]));
  1341.               caption2(qindent + 'Sectors/cluster');
  1342.               writeln(bootrec[$0D]);
  1343.               caption2(qindent + 'Reserved sectors');
  1344.               writeln(cbw(bootrec[$0F], bootrec[$0E]));
  1345.               caption2(qindent + 'FAT''s');
  1346.               writeln(bootrec[$10]);
  1347.               caption2(qindent + 'Root directory entries');
  1348.               writeln(cbw(bootrec[$12], bootrec[$11]));
  1349.               caption2(qindent + 'Total sectors');
  1350.               writeln(cbw(bootrec[$14], bootrec[$13]));
  1351.               media(bootrec[$15]);
  1352.               caption2(qindent + 'Sectors/FAT');
  1353.               writeln(cbw(bootrec[$17], bootrec[$16]));
  1354.               caption2(qindent + 'Sectors/track');
  1355.               writeln(cbw(bootrec[$19], bootrec[$18]));
  1356.               caption2(qindent + 'Heads');
  1357.               writeln(cbw(bootrec[$1B], bootrec[$1A]));
  1358.               caption2(qindent + 'Hidden sectors');
  1359.               writeln(cbw(bootrec[$1D], bootrec[$1C]))
  1360.             end else begin
  1361.               writeln(qindent, 'Couldn''t read boot record');
  1362.               write(qindent);
  1363.               xbyte1 := hi(bootstat);
  1364.               case xbyte1 of
  1365.                 $80 : writeln('Attachment failed to respond');
  1366.                 $40 : writeln('Seek operation failed');
  1367.                 $20 : writeln('Controller failed');
  1368.                 $10 : writeln('Data error (bad CRC)');
  1369.                 $08 : writeln('DMA failure');
  1370.                 $04 : writeln('Sector not found');
  1371.                 $03 : writeln('Write-protect fault');
  1372.                 $02 : writeln('Bad address mark');
  1373.                 $01 : writeln('Bad command');
  1374.                 $00 :
  1375.                 else
  1376.                   unknown('error', xbyte1, 2)
  1377.               end;
  1378.               write(qindent);
  1379.               xbyte1 := lo(bootstat);
  1380.               case xbyte1 of
  1381.                 $00 : writeln('Write-protect error');
  1382.                 $01 : writeln('Unknown unit');
  1383.                 $02 : writeln('Drive not ready');
  1384.                 $03 : writeln('Unknown command');
  1385.                 $04 : writeln('Data error (bad CRC)');
  1386.                 $05 : writeln('Bad request structure length');
  1387.                 $06 : writeln('Seek error');
  1388.                 $07 : writeln('Unknown media type');
  1389.                 $08 : writeln('Sector not found');
  1390.                 $09 : writeln('Printer out of paper');
  1391.                 $0A : writeln('Write fault');
  1392.                 $0B : writeln('Read fault');
  1393.                 $0C : writeln('General failure')
  1394.                 else
  1395.                   unknown('error', xbyte1, 2)
  1396.               end
  1397.             end;
  1398.  
  1399.           end
  1400.         end;
  1401.         window(1, 1, twidth, tlength);
  1402.         gotoxy(x2, tlength);
  1403.         xbool2 := false;
  1404.         repeat
  1405.           repeat
  1406.           until keypressed;
  1407.           xchar1 := readkey;
  1408.           if keypressed then
  1409.             xchar2 := readkey
  1410.           else
  1411.             xchar2 := #0;
  1412.           if (xchar1 = #27) and (xchar2 = #0) then begin
  1413.             xbool2 := true;
  1414.             xbool1 := true
  1415.           end else if (xchar1 = #0) and (xchar2 = #71) and (pg > 1) then begin
  1416.             xbool2 := true;
  1417.             pg := 1
  1418.           end else if (xchar1 = #0) and (xchar2 = #73) and (pg > 1) then begin
  1419.             xbool2 := true;
  1420.             dec(pg)
  1421.           end else if (xchar1 = #0) and (xchar2 = #79) and (pg < pgmax) then
  1422.             begin
  1423.             xbool2 := true;
  1424.             pg := pgmax
  1425.           end else if (xchar1 = #0) and (xchar2 = #81) and (pg < pgmax) then
  1426.             begin
  1427.             xbool2 := true;
  1428.             inc(pg)
  1429.           end else begin
  1430.             sound(220);
  1431.             delay(100);
  1432.             nosound
  1433.           end
  1434.         until xbool2
  1435.       until xbool1;
  1436.       textattr := attrsave;
  1437.       clrscr
  1438.     end else begin
  1439.       writeln;
  1440.       writeln('SYSID requires DOS version 3.0 or later');
  1441.       write('Your DOS version is ');
  1442.       showvers
  1443.     end
  1444.   end
  1445. end.
  1446.